home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / picklst.exe / TEST.PAS < prev   
Pascal/Delphi Source File  |  1991-07-26  |  7KB  |  229 lines
  1. program Test;
  2.  
  3. {A general program for testing new objects.  This demonstrates TPickDialog
  4.  and TTextDialog.}
  5.  
  6. {********************************}
  7. {***Programmed by             ***}
  8. {***Blake Watson              ***}
  9. {***CIS number 70303,373      ***}
  10. {********************************}
  11.  
  12. uses App, Menus, Objects, Drivers, Gadgets, Views, Memory,
  13.      Objects1, Dialogs1;
  14.  
  15. type
  16.  
  17.     Main = object(TApplication)
  18.           Clock: PClockView;
  19.           Heap : PHeapView;
  20.        constructor Init;
  21.        procedure   InitMenuBar; virtual;
  22.        procedure   Idle; virtual;
  23.        procedure   HandleEvent(var Event: TEvent); virtual;
  24.        end;
  25.  
  26.  
  27. const
  28.    cmObjectA = 100; cmObjectB = 101; cmObjectC = 102; cmObjectD = 103;
  29.    cmObjectE = 104; cmObjectF = 105; cmObjectG = 106; cmObjectH = 107;
  30.  
  31. function HSB(r:trect): pScrollBar;
  32. begin
  33.    r.assign(r.a.x, r.b.y, r.b.x, r.b.y+1);
  34.    HSB := New(pScrollBar, init(R));
  35.    end;
  36.  
  37. function VSB(R:tRect): pScrollBar;
  38. begin
  39.    r.Assign(r.b.x, r.a.y, r.b.x+1, r.b.y);
  40.    VSB := New(pScrollBar, init(R));
  41.    end;
  42.  
  43. constructor Main.Init;
  44. var R: TRect;
  45. begin
  46.    TApplication.Init;
  47.  
  48.    GetExtent(R);
  49.    R.A.X := R.B.X - 9; R.B.Y := R.A.Y + 1;
  50.    Clock := New(PClockView, Init(R));
  51.    Insert(Clock);
  52.  
  53.    GetExtent(R);
  54.    Dec(R.B.X);
  55.    R.A.X := R.B.X - 9; R.A.Y := R.B.Y - 1;
  56.    Heap := New(PHeapView, Init(R));
  57.    Insert(Heap);
  58.  
  59.    end;
  60.  
  61. procedure Main.Idle;
  62. begin
  63.   TApplication.Idle;
  64.   Clock^.Update;
  65.   Heap^.Update;
  66.   end;
  67.  
  68. procedure Main.InitMenuBar;
  69. var R: TRect;
  70. begin
  71.    R.Assign(0,0,80,1);
  72.    MenuBar := New(PMenuBar, Init(R, NewMenu(
  73.       NewSubMenu('~T~ests', 0, NewMenu(
  74.          NewItem('Object ~A~', '', 0, cmObjectA, 0,
  75.          NewItem('Object ~B~', '', 0, cmObjectB, 0,
  76.          NewItem('Object ~C~', '', 0, cmObjectC, 0,
  77.          NewItem('Object ~D~', '', 0, cmObjectD, 0,
  78.          NewItem('Object ~E~', '', 0, cmObjectE, 0,
  79.          NewItem('Object ~F~', '', 0, cmObjectF, 0,
  80.          NewItem('Object ~G~', '', 0, cmObjectG, 0,
  81.          NewItem('Object ~H~', '', 0, cmObjectH, 0,
  82.          nil))))))))),
  83.       nil))));
  84.    end;
  85.  
  86. procedure Main.HandleEvent;
  87. var W: PWindow;
  88.     R: TRect;
  89.     H,V: PScrollBar;
  90.  
  91. procedure ObjectA;
  92. var L: PSelectCollection;
  93.     P: PPickDialog;
  94.     W: Word;
  95. begin
  96.    L := New(PSelectCollection, Init('10,Test,1'));
  97.    {The string passed to TSelectCollection.Init has the number of items
  98.     in the list, the name of the list, and the number of items selectable.
  99.     This may seem an unusual way to pass parameters, but it anticipates
  100.     TTextDialog, which reads in the string from a text file.}
  101.  
  102.    L^.NewItem('1) Item One'); L^.NewItem('2) Item Two'); L^.NewItem('3) Item Three');
  103.    L^.NewItem('4) Item Four'); L^.NewItem('5) Item Five'); L^.NewItem('6) Item Six');
  104.    L^.NewItem('7) Item Seven'); L^.NewItem('8) Item Eight'); L^.NewItem('9) Item Nine');
  105.    L^.NewItem('A) Item A');
  106.    {The list, naturally, may be created in any fashion one wishes, as long
  107.     as it is a TSelectCollection.  The code is "minimal fuss" code.  It is
  108.     highly mouse sensitive, tracking the mouse moves.  A click on an item
  109.     when only one item may be selected causes TPickDialog to delete itself.
  110.     This eliminates the need for pressing additional "OK" buttons.  Also,
  111.     pressing the first letter of an item will select that item!  In this
  112.     version of the code, an keystroke with no corresponding item will select
  113.     whatever item the highlight bar is currently on.}
  114.  
  115.    P := New(PPickDialog, Init(L, 10,10));
  116.    W := ExecView(ValidView(P));
  117.  
  118.    {One item in L will have its selected field toggled on.}
  119.    Dispose(L, Done);
  120.    If P<>nil then Dispose(P, Done);
  121.    end;
  122.  
  123. procedure ObjectB;
  124. var L: PSelectCollection;
  125.     P: PPickDialog;
  126.     W: Word;
  127. begin
  128.    L := New(PSelectCollection, Init('10,Test,2'));
  129.    {Here's the same thing, with two items selectable.  Return or a right
  130.     mouse click will end the dialog.}
  131.  
  132.    L^.NewItem('1) Item One'); L^.NewItem('2) Item Two'); L^.NewItem('3) Item Three');
  133.    L^.NewItem('4) Item Four'); L^.NewItem('5) Item Five'); L^.NewItem('6) Item Six');
  134.    L^.NewItem('7) Item Seven'); L^.NewItem('8) Item Eight'); L^.NewItem('9) Item Nine');
  135.    L^.NewItem('A) Item A');
  136.  
  137.    P := New(PPickDialog, Init(L, 10,10));
  138.    W := ExecView(ValidView(P));
  139.  
  140.    {Two items in L will have its selected field toggled on.  You could then
  141.     say,}
  142.  
  143.    L^.DropNotSelected;
  144.  
  145.    {Which would dispose of all the items not selected by the user.}
  146.  
  147.    Dispose(L, Done);
  148.    If P<>nil then Dispose(P, Done);
  149.    end;
  150.  
  151. procedure ObjectC;
  152. var L: PSelectCollection;
  153.     P: PTextDialog;
  154.     W: WOrd;
  155. begin
  156.    P := New(PTextDialog, Init(pointer(L),5,5,'SAMPLE.TXT','List 1'));
  157.    {This takes "List 1" out of the SAMPLE.TXT text file.  TTextDialog is
  158.     case sensitive.  It builds the list from string items following a header,
  159.     which matches the "NoItems,Name,NoToSelect" format given for
  160.     TSelectCollection.}
  161.  
  162.    W := ExecView(ValidView(P));
  163.    {L will come back with the entire list!  Not just selected items.  L is passed
  164.     generic pointer to allow for future expansion, where L might change.  As
  165.     I wrote this object when first learning TV, I found it necessary to do
  166.     so for future objects where L was a descendant of PSelectCollection.}
  167.  
  168.    If L<>nil then Dispose(L, Done);
  169.    {If SAMPLE.TXT or "List 1" does not exist, L will never be initialized.}
  170.    If P<>nil then Dispose(P, Done);
  171.  
  172.    end;
  173.  
  174. procedure ObjectD;
  175. var L: PSelectCollection;
  176.     P: PTextDialog;
  177.     W: WOrd;
  178. begin
  179.    {The following code is identical to the code for Object C, except that
  180.     a different list is specified.}
  181.    P := New(PTextDialog, Init(pointer(L),5,5,'SAMPLE.TXT','List 2'));
  182.    W := ExecView(ValidView(P));
  183.    If L<>nil then Dispose(L, Done);
  184.    If P<>nil then Dispose(P, Done);
  185.    end;
  186.  
  187. procedure ObjectE;
  188. begin
  189.  
  190.    end;
  191.  
  192. procedure ObjectF;
  193. begin
  194.  
  195.    end;
  196.  
  197. procedure ObjectG;
  198. begin
  199.    end;
  200.  
  201. procedure ObjectH;
  202. begin
  203.    end;
  204.  
  205. begin
  206.    If Event.What = evCommand then
  207.    begin
  208.       case Event.Command of
  209.          cmObjectA: ObjectA;
  210.          cmObjectB: ObjectB;
  211.          cmObjectC: ObjectC;
  212.          cmObjectD: ObjectD;
  213.          cmObjectE: ObjectE;
  214.          cmObjectF: ObjectF;
  215.          cmObjectG: ObjectG;
  216.          cmObjectH: ObjectH;
  217.          end
  218.       end;
  219.    TApplication.HandleEvent(EVent);
  220.    end;
  221.  
  222. var M: Main;
  223.  
  224. begin
  225.    M.Init;
  226.    M.Run;
  227.    M.DOne;
  228.  
  229. end.